home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
byte0487.arc
/
TELLO.ARC
/
TRIANG.LSP
< prev
Wrap
Text File
|
1980-01-01
|
2KB
|
60 lines
; TRIANG
(defvar board '#(1 1 1 1 1 0 1 1 1 1 1 1 1 1 1 1))
(defvar sequence (make-array 14. ':initial-element 0.))
(defvar *a* '#(1 2 4 3 5 6 1 3 6 2 5 4 11. 12. 13. 7 8. 4
4 7 11. 8. 12. 13. 6 10. 15. 9. 14. 13. 13. 14. 15. 9. 10. 6 6))
(defvar *b* '#(2 4 7 5 8. 9. 3 6 10. 5 9. 8. 12. 13. 14. 8. 9. 5
2 4 7 5 8. 9. 3 6 10. 5 9. 8. 12. 13. 14. 8. 9. 5 5))
(defvar *c* '#(4 7 11. 8. 12. 13. 6 10. 15. 9. 14. 13. 13. 14. 15. 9. 10. 6
1 2 4 3 5 6 1 3 6 2 5 4 11. 12. 13. 7 8. 4 4))
(defvar answer)
(defvar final)
(defun last-position ()
(do ((i 1 (1+ i)))
((= i 16.) 0)
(if (= 1 (aref board i))
(return i))))
(defun try (i depth)
(cond ((= depth 14)
(let ((lp (last-position)))
(unless (member lp final)
(push lp final)))
(push (cdr (coerce sequence 'list)) answer) t)
((and (= 1 (aref board (aref *a* i)))
(= 1 (aref board (aref *b* i)))
(= 0 (aref board (aref *c* i))))
(setf (aref board (aref *a* i)) 0)
(setf (aref board (aref *b* i)) 0)
(setf (aref board (aref *c* i)) 1)
(setf (aref sequence depth) i)
(do ((j 0 (1+ j))
(depth (1+ depth)))
((or (= j 36.)
(try j depth)) ()))
(setf (aref board (aref *a* i)) 1)
(setf (aref board (aref *b* i)) 1)
(setf (aref board (aref *c* i)) 0) ())))
(defun gogogo (i)
(dotimes (j 16)
(setf (aref board j) 1))
(setf (aref board 5) 0)
(let ((answer ())
(final ()))
(try i 1)))
(define-timer triang "Triang" (gogogo 22.))
(qa-attempt "Triang" (gogogo 22.) nil)
(defun triang-test ()
(dotimes (j 16)
(setf (aref board j) 1))
(setf (aref board 5) 0)
(let ((answer ())
(final ()))
(try 22. 1)
(= (length answer) 775.)))